perm filename LAB.VLA[VLI,LSP] blob
sn#379955 filedate 1978-09-08 generic text, type T, neo UTF8
;****************************** 3-Sep-78 22:58:56 &PASS1 ;
( EVAL
( MAPC ' (
RUNBY ; NSUBR ;
RUNLAB ; 1SUBR ;
VAHAU ; 0SUBR ;
VADRO ; 0SUBR ;
VAGAU ; 0SUBR ;
CONDAMNE ; 0SUBR ;
CLOSE ; 0SUBR ;
CESTFINI ; 1SUBR ;
HAU ; 0SUBR ;
DRO ; 0SUBR ;
BAS ; 0SUBR ;
GAU ; 0SUBR ;
AUTOUR ; 0SUBR ;
TESTTOUR ; 0SUBR ;
SIL-Y-A ; 3SUBR ;
TER ; 0SUBR ;
PP ; 3SUBR ;
OCCUR ; 2SUBR ;
ED ; 1SUBR ;
EG ; 1SUBR ;
DECLARE ; NSUBR ;
COMBC ; 1SUBR ;
MIN ; 2SUBR ;
MINI ; 1SUBR ;
INIT1 ; 0SUBR ;
INIT ; 0SUBR ;
TTYS ; NSUBR ;
IMPWITH ; 1SUBR ;
DISPL ; 3SUBR ;
STRING1 ; 2SUBR ;
LONG ; 1SUBR ;
ENTER ; 1SUBR ;
E1 ; 1SUBR ;
E2 ; 1SUBR ;
TTYC ; 2SUBR ;
CADRE ; 1SUBR ;
EN1 ; 3SUBR ;
TYO1 ; 1SUBR ;
TTYC1 ; 2SUBR ;
AVANCE ; 0SUBR ;
PUTA ; 2SUBR ;
) (LAMBDA (L) (PUT L NIL 'ENTRY)) )
)
;****************************** 3-Sep-78 22:59:00 &PASS2 ;
; 3 RUNBY-------------------------------------------------------
(DE RUNBY (IND TER IMP I J K HB GD L1 L2 L4 DIR SORTIE)
(IF IND NIL (SETQ NI 0 NJ 0))
(ESCAPE *EX
(SETQQ
L1 ((DECR I) J I (INCR J) (INCR I) J I (DECR J))
L2 ((INCR HB) (INCR GD) (DECR HB) (DECR GD))
L4 ((1- I) J I (1+ J) (1+ I) J I (1- J))
DIR (94 25 31 95)
SORTIE *
MURS (| /_ - +)
HB 0
GD 0
K 0)
(IF IND
NIL
(PRINT "quelles dimensions")
(SETQ NI (READ) NJ (READ))
(DECLARE 'LABO NI NJ 'LABC 'LABI)
(DECLARE 'LAB NI NJ 'LABC 'LABI)
(DECLARE 'L NI NJ 'LC 'LI)
(CADRE 'LAB)
(SETQ XPOS 5 YPOS 10)
(INIT1)
(DISPL 'LAB)
(SETQ XPOS 5 YPOS 10)
(PRINT "donnez le labyrinth s.v.p.")
(PRINT "(pour les murs utilisez les caracteres |,-,_)")
(ESCAPE %EX (EN1 2 2)))
(PRINT "ou est le but ?")
(SETQ REP1 (READ) REP2 (READ))
(MAPC '(LABO L)
(LAMBDA (X)
(MAPARRAY X '(LAMBDA (-X) (SETA X -X (LAB -X))))))
(SETQA LAB (LABI REP1 REP2) SORTIE)
(SETQA L (LI REP1 REP2) SORTIE)
(INIT)
(SETQA LAB (LABI I J) 0)
(SETQA L (LABI I J) 0)
(TYI)
(SETQ OLDI I OLDJ J)
(RUNLAB)))
FUNCTION LENGTH = 275
#LABEL = NIL
#LABEL = ((G104 POPJ P) (G108 . G106))
#LAP LENGTH = 138
;
;;;;;;
(ENTRY %F1RUNBY SUBR 1)
(JSP L :SBIND1)
(XWD '%F1RUNBY 'X)
(MOVEI 2 '(LAMBDA (-X) (SETA X -X (LAB -X))))
(JRST 0 MAPARRAY)
;;;;;;
(ENTRY RUNBY SUBR)
(JSP L :SBIND)
(XWD 'RUNBY '(IND TER IMP I J K HB GD L1 L2 L4 DIR SORTIE))
(GETVAL 1 IND)
(JUMPN 1 G102)
G101
(MOVEI 1 '0)
(PUTVAL 1 NI)
(MOVEI 1 '0)
(PUTVAL 1 NJ)
G102
(JSP L :ESBIND)
(XWD :VPOPJ '*EX)
(MOVEI 1 '((DECR I) J I (INCR J) (INCR I) J I (DECR J)))
(PUTVAL 1 L1)
(MOVEI 1 '((INCR HB) (INCR GD) (DECR HB) (DECR GD)))
(PUTVAL 1 L2)
(MOVEI 1 '((1- I) J I (1+ J) (1+ I) J I (1- J)))
(PUTVAL 1 L4)
(MOVEI 1 '(94 25 31 95))
(PUTVAL 1 DIR)
(MOVEI 1 '*)
(PUTVAL 1 SORTIE)
(MOVEI 1 '(| /_ - +))
(PUTVAL 1 MURS)
(MOVEI 1 '0)
(PUTVAL 1 HB)
(MOVEI 1 '0)
(PUTVAL 1 GD)
(MOVEI 1 '0)
(PUTVAL 1 K)
(GETVAL 1 IND)
(JUMPN 1 G106)
G105
(MOVEI 1 '"quelles dimensions")
(PUSHJ P :$PRINT)
(PUSHJ P READ)
(PUTVAL 1 NI)
(PUSHJ P READ)
(PUTVAL 1 NJ)
(PUSH P %T1) ; (XWD -1 DECLARE) ;
(PUSH P %T2) ; 'LABO ;
(GETVAL 1 NI)
(PUSH P 1)
(GETVAL 1 NJ)
(PUSH P 1)
(PUSH P %T3) ; 'LABC ;
(MOVEI 1 'LABI)
(JSP L :NSUBR)
(PUSH P %T1) ; (XWD -1 DECLARE) ;
(PUSH P %T4) ; 'LAB ;
(GETVAL 1 NI)
(PUSH P 1)
(GETVAL 1 NJ)
(PUSH P 1)
(PUSH P %T3) ; 'LABC ;
(MOVEI 1 'LABI)
(JSP L :NSUBR)
(PUSH P %T1) ; (XWD -1 DECLARE) ;
(PUSH P %T5) ; 'L ;
(GETVAL 1 NI)
(PUSH P 1)
(GETVAL 1 NJ)
(PUSH P 1)
(PUSH P %T6) ; 'LC ;
(MOVEI 1 'LI)
(JSP L :NSUBR)
(MOVEI 1 'LAB)
(PUSHJ P CADRE)
(MOVEI 1 '5)
(PUTVAL 1 XPOS)
(MOVEI 1 '10)
(PUTVAL 1 YPOS)
(PUSHJ P INIT1)
(MOVEI 1 'LAB)
(SETZB 3 2)
(PUSHJ P DISPL)
(MOVEI 1 '5)
(PUTVAL 1 XPOS)
(MOVEI 1 '10)
(PUTVAL 1 YPOS)
(MOVEI 1 '"donnez le labyrinth s.v.p.")
(PUSHJ P :$PRINT)
(MOVEI 1 '"(pour les murs utilisez les caracteres |,-,_)")
(PUSHJ P :$PRINT)
(JSP L :ESBIND)
(XWD G106 '%EX)
(MOVEI 1 '2)
(MOVEI 2 '2)
(SETZ 3)
(PUSHJ P EN1)
G107
(MOVEI 2 '%EX)
(JRST 0 :ESCAPT)
G106
(MOVEI 1 '"ou est le but ?")
(PUSHJ P :$PRINT)
(PUSHJ P READ)
(PUTVAL 1 REP1)
(PUSHJ P READ)
(PUTVAL 1 REP2)
(MOVEI 1 '(LABO L))
(MOVEI 2 '%F1RUNBY)
(PUSHJ P :$MAPC1)
(MOVEI 1 '(LABI REP1 REP2))
(PUSHJ P EVAL)
(GETVAL 2 SORTIE)
(ARRAY 5 LAB)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(MOVEI 1 '(LI REP1 REP2))
(PUSHJ P EVAL)
(GETVAL 2 SORTIE)
(ARRAY 5 L)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(PUSHJ P INIT)
(MOVEI 1 '(LABI I J))
(PUSHJ P EVAL)
(MOVEI 2 '0)
(ARRAY 5 LAB)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(MOVEI 1 '(LABI I J))
(PUSHJ P EVAL)
(MOVEI 2 '0)
(ARRAY 5 L)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(41 0 5)
(JSP L :$CRANB)
(GETVAL 1 I)
(PUTVAL 1 OLDI)
(GETVAL 1 J)
(PUTVAL 1 OLDJ)
(SETZ 1)
(PUSHJ P RUNLAB)
G103
(MOVEI 2 '*EX)
(JRST 0 :ESCAPT)
;---------- # T B L
#TBL LENGTH = 6 ;
%T1 (XWD -1 DECLARE)
%T2 'LABO
%T3 'LABC
%T4 'LAB
%T5 'L
%T6 'LC
(END)
; 4 RUNLAB-------------------------------------------------------
(DE RUNLAB (A)
(COND
((SIL-Y-A 1 SORTIE (AUTOUR)) (CESTFINI))
((SIL-Y-A 4 MURS (AUTOUR))
(TTYS 18 30 "IMPOSSIBLE")
(CESTFINI))
((SIL-Y-A 3 MURS (AUTOUR))
(IF (SIL-Y-A 3 MURS (CDR (AUTOUR)))
(PROGN (CLOSE) (VAHAU))
(CONDAMNE)))
((NEQ (DRO) 0) (IF (EQ (HAU) 0) (VAHAU) (VAGAU)))
(T (VADRO))))
FUNCTION LENGTH = 76
#LABEL = ((G109 POPJ P) (G117 . G109) (G114 . G109))
#LAP LENGTH = 53
;
;;;;;;
(ENTRY RUNLAB SUBR 1)
(JSP L :SBIND1)
(XWD 'RUNLAB 'A)
(GETVAL 1 SORTIE)
(PUSH P 1)
(PUSHJ P AUTOUR)
(MOVEI 3 0 1)
(POP P 2)
(MOVEI 1 '1)
(PUSHJ P SIL-Y-A)
(JUMPE 1 G110)
(SETZ 1)
(JRST 0 CESTFINI)
G110
(GETVAL 1 MURS)
(PUSH P 1)
(PUSHJ P AUTOUR)
(MOVEI 3 0 1)
(POP P 2)
(MOVEI 1 '4)
(PUSHJ P SIL-Y-A)
(JUMPE 1 G111)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(PUSH P %T2) ; '18 ;
(PUSH P %T3) ; '30 ;
(MOVEI 1 '"IMPOSSIBLE")
(JSP L :NSUBR)
(SETZ 1)
(JRST 0 CESTFINI)
G111
(GETVAL 1 MURS)
(PUSH P 1)
(PUSHJ P AUTOUR)
(MOVEI 3 0 1)
(POP P 2)
(MOVEI 1 '3)
(PUSHJ P SIL-Y-A)
(JUMPE 1 G112)
(GETVAL 1 MURS)
(PUSH P 1)
(PUSHJ P AUTOUR)
(CDR 1 1)
(MOVEI 3 0 1)
(POP P 2)
(MOVEI 1 '3)
(PUSHJ P SIL-Y-A)
(JUMPE 1 CONDAMNE)
(PUSHJ P CLOSE)
(JRST 0 VAHAU)
G112
(PUSHJ P DRO)
(CAIN 1 '0)
(JRST 0 VADRO)
(PUSHJ P HAU)
(CAIN 1 '0)
(JRST 0 VAHAU)
(JRST 0 VAGAU)
;---------- # T B L
#TBL LENGTH = 3 ;
%T1 (XWD -1 TTYS)
%T2 '18
%T3 '30
(END)
; 5 VAHAU-------------------------------------------------------
(DE VAHAU ()
(TER)
(IMPWITH (CAR DIR))
(EVAL (1 L2))
(TESTTOUR)
(EVAL (1 L1))
(EVAL (2 L1))
(RUNLAB))
FUNCTION LENGTH = 30
#LABEL = NIL
#LAP LENGTH = 17
;
;;;;;;
(ENTRY VAHAU SUBR 0)
(PUSHJ P TER)
(GETVAL 1 DIR)
(CAR 1 1)
(PUSHJ P IMPWITH)
(GETVAL 1 L2)
(CAR 1 1)
(PUSHJ P EVAL)
(PUSHJ P TESTTOUR)
(GETVAL 1 L1)
(CAR 1 1)
(PUSHJ P EVAL)
(GETVAL 1 L1)
(CDR 1 1)
(CAR 1 1)
(PUSHJ P EVAL)
(SETZ 1)
(JRST 0 RUNLAB)
(END)
; 6 VADRO-------------------------------------------------------
(DE VADRO ()
(TER)
(IMPWITH (CADR DIR))
(EVAL (2 L2))
(TESTTOUR)
(EVAL (3 L1))
(EVAL (4 L1))
(SETQ
L1 (EG (EG L1))
L2 (EG L2)
L4 (EG (EG L4))
DIR (EG DIR))
(RUNLAB))
FUNCTION LENGTH = 52
#LABEL = NIL
#LAP LENGTH = 37
;
;;;;;;
(ENTRY VADRO SUBR 0)
(PUSHJ P TER)
(GETVAL 1 DIR)
(CDR 1 1)
(CAR 1 1)
(PUSHJ P IMPWITH)
(GETVAL 1 L2)
(CDR 1 1)
(CAR 1 1)
(PUSHJ P EVAL)
(PUSHJ P TESTTOUR)
(GETVAL 1 L1)
(CDR 1 1)
(CDR 1 1)
(CAR 1 1)
(PUSHJ P EVAL)
(GETVAL 1 L1)
(CDR 1 1)
(CDR 1 1)
(CDR 1 1)
(CAR 1 1)
(PUSHJ P EVAL)
(GETVAL 1 L1)
(PUSHJ P EG)
(PUSHJ P EG)
(PUTVAL 1 L1)
(GETVAL 1 L2)
(PUSHJ P EG)
(PUTVAL 1 L2)
(GETVAL 1 L4)
(PUSHJ P EG)
(PUSHJ P EG)
(PUTVAL 1 L4)
(GETVAL 1 DIR)
(PUSHJ P EG)
(PUTVAL 1 DIR)
(SETZ 1)
(JRST 0 RUNLAB)
(END)
; 7 VAGAU-------------------------------------------------------
(DE VAGAU ()
(TER)
(IMPWITH (4 DIR))
(EVAL (4 L2))
(TESTTOUR)
(EVAL (7 L1))
(EVAL (8 L1))
(SETQ
L1 (ED (ED L1))
L2 (ED L2)
L4 (ED (ED L4))
DIR (ED DIR))
(RUNLAB))
FUNCTION LENGTH = 52
#LABEL = NIL
#LAP LENGTH = 38
;
;;;;;;
(ENTRY VAGAU SUBR 0)
(PUSHJ P TER)
(GETVAL 1 DIR)
(CDR 1 1)
(CDR 1 1)
(CDR 1 1)
(CAR 1 1)
(PUSHJ P IMPWITH)
(GETVAL 1 L2)
(CDR 1 1)
(CDR 1 1)
(CDR 1 1)
(CAR 1 1)
(PUSHJ P EVAL)
(PUSHJ P TESTTOUR)
(MOVEI 1 '7)
(GETVAL 2 L1)
(PUSHJ P CNTH)
(PUSHJ P EVAL)
(MOVEI 1 '8)
(GETVAL 2 L1)
(PUSHJ P CNTH)
(PUSHJ P EVAL)
(GETVAL 1 L1)
(PUSHJ P ED)
(PUSHJ P ED)
(PUTVAL 1 L1)
(GETVAL 1 L2)
(PUSHJ P ED)
(PUTVAL 1 L2)
(GETVAL 1 L4)
(PUSHJ P ED)
(PUSHJ P ED)
(PUTVAL 1 L4)
(GETVAL 1 DIR)
(PUSHJ P ED)
(PUTVAL 1 DIR)
(SETZ 1)
(JRST 0 RUNLAB)
(END)
; 8 CONDAMNE-------------------------------------------------------
(DE CONDAMNE ()
(TER)
(SETQ -X (COMBC (AUTOUR)))
(CLOSE)
(EVAL ((* -X 2) L1))
(EVAL ((SUB1 (* -X 2)) L1))
(IMPWITH (-X DIR))
(RUNLAB))
FUNCTION LENGTH = 40
#LABEL = NIL
#LAP LENGTH = 16
;
;;;;;;
(ENTRY CONDAMNE SUBR 0)
(PUSHJ P TER)
(PUSHJ P AUTOUR)
(PUSHJ P COMBC)
(PUTVAL 1 -X)
(PUSHJ P CLOSE)
(MOVEI 1 '((* -X 2) L1))
(PUSHJ P EVAL)
(PUSHJ P EVAL)
(MOVEI 1 '((SUB1 (* -X 2)) L1))
(PUSHJ P EVAL)
(PUSHJ P EVAL)
(MOVEI 1 '(-X DIR))
(PUSHJ P EVAL)
(PUSHJ P IMPWITH)
(SETZ 1)
(JRST 0 RUNLAB)
(END)
; 9 CLOSE-------------------------------------------------------
(DE CLOSE () (SETQ HB 0 GD 0 K 0) (SETQA LAB (LABI I J) '+))
FUNCTION LENGTH = 22
#LABEL = NIL
#LAP LENGTH = 14
;
;;;;;;
(ENTRY CLOSE SUBR 0)
(MOVEI 1 '0)
(PUTVAL 1 HB)
(MOVEI 1 '0)
(PUTVAL 1 GD)
(MOVEI 1 '0)
(PUTVAL 1 K)
(MOVEI 1 '(LABI I J))
(PUSHJ P EVAL)
(MOVEI 2 '+)
(ARRAY 5 LAB)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(MOVEI 1 0 2)
(POPJ P)
(END)
; 10 CESTFINI-------------------------------------------------------
(DE CESTFINI (-X)
(TER)
(DISPLAY '(127 7))
(PRINT "j'l'ai eu")
(MAPARRAY 'LABO (LAMBDA (X) (SETQA LAB X (LABO X))))
(SETQ TER (MINI TER))
(WHILE TER
(SETQA LABO (SETQ -X (APPLY 'LABI (NEXTL TER))) (L -X)))
(SETQ YPOS (PLUS 20 YPOS NJ))
(DISPL 'LABO)
(SETQ YPOS 10 XPOS 5)
(TYS)
(PRINT "vous en voulez plus ?")
(IF (EQ (TYI) 110)
(PROGN
(PPIOT 0 0)
(DISPLAY '(127 30))
(RUN '(SYS (KJOB))))
(TTYS 18 30 " ")
(PRINT "voulez vous utilisez l'ancien labyrinthe ?")
(SETQ IND (TYI))
(IF (EQ IND '111) NIL (SETQ IND NIL))
(IF IND NIL (PPIOT 4 1) (PPIOT 4 2) (PPIOT 0 0))
(RUNBY IND)))
FUNCTION LENGTH = 156
#LABEL = NIL
#LABEL = ((G122 POPJ P))
#LAP LENGTH = 102
;
;;;;;;
(ENTRY %F2CESTFINI SUBR 1)
(JSP L :SBIND1)
(XWD '%F2CESTFINI 'X)
(PUSH P 1)
(MOVEI 1 '(LABO X))
(PUSHJ P EVAL)
(MOVEI 2 0 1)
(POP P 1)
(ARRAY 5 LAB)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(MOVEI 1 0 2)
(POPJ P)
;;;;;;
(ENTRY CESTFINI SUBR 1)
(JSP L :SBIND1)
(XWD 'CESTFINI '-X)
(PUSHJ P TER)
(MOVEI 1 '(127 7))
(SETZ 2)
(PUSHJ P DISPLAY)
(MOVEI 1 '"j'l'ai eu")
(PUSHJ P :$PRINT)
(MOVEI 1 'LABO)
(MOVEI 2 '%F2CESTFINI)
(PUSHJ P MAPARRAY)
(GETVAL 1 TER)
(PUSHJ P MINI)
(PUTVAL 1 TER)
(JRST 0 G120)
G119
(MOVEI 1 'LABI)
(GETVAL 3 TER)
(CAR 2 3)
(CDR 3 3)
(PUTVAL 3 TER)
(PUSHJ P APPLY)
(PUTVAL 1 -X)
(PUSH P 1)
(MOVEI 1 '(L -X))
(PUSHJ P EVAL)
(MOVEI 2 0 1)
(POP P 1)
(ARRAY 5 LABO)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
G120
(GETVAL 1 TER)
(JUMPN 1 G119)
(GETVAL 1 YPOS)
(MOVEI 5 20)
(ADD 5 :MEM 1)
(GETVAL 2 NJ)
(ADD 5 :MEM 2)
(JSP L :$CRANB)
(PUTVAL 1 YPOS)
(MOVEI 1 'LABO)
(SETZB 3 2)
(PUSHJ P DISPL)
(MOVEI 1 '10)
(PUTVAL 1 YPOS)
(MOVEI 1 '5)
(PUTVAL 1 XPOS)
(PUSHJ P TYS)
(MOVEI 1 '"vous en voulez plus ?")
(PUSHJ P :$PRINT)
(41 0 5)
(JSP L :$CRANB)
(CAIE 1 '110)
(JRST 0 G121)
(MOVEI 1 '0)
(MOVEI 2 '0)
(PUSHJ P PPIOT)
(MOVEI 1 '(127 30))
(SETZ 2)
(PUSHJ P DISPLAY)
(MOVEI 1 '(SYS (KJOB)))
(SETZ 2)
(JRST 0 RUN)
G121
(PUSH P %T1) ; (XWD -1 TTYS) ;
(PUSH P %T2) ; '18 ;
(PUSH P %T3) ; '30 ;
(MOVEI 1 '" ")
(JSP L :NSUBR)
(MOVEI 1 '"voulez vous utilisez l'ancien labyrinthe ?")
(PUSHJ P :$PRINT)
(41 0 5)
(JSP L :$CRANB)
(PUTVAL 1 IND)
(CAIN 1 '111)
(JRST 0 G124)
G123
(SETNIL IND)
G124
(GETVAL 1 IND)
(JUMPN 1 G126)
G125
(MOVEI 1 '4)
(MOVEI 2 '1)
(PUSHJ P PPIOT)
(MOVEI 1 '4)
(MOVEI 2 '2)
(PUSHJ P PPIOT)
(MOVEI 1 '0)
(MOVEI 2 '0)
(PUSHJ P PPIOT)
G126
(PUSH P %T4) ; (XWD -1 RUNBY) ;
(GETVAL 1 IND)
(JRST 0 :NSUBRP)
;---------- # T B L
#TBL LENGTH = 4 ;
%T1 (XWD -1 TTYS)
%T2 '18
%T3 '30
%T4 (XWD -1 RUNBY)
(END)
; 11 HAU-------------------------------------------------------
(DE HAU () (LABC (EVAL (1 L4)) (EVAL (2 L4))))
FUNCTION LENGTH = 16
#LABEL = NIL
#LAP LENGTH = 2
;
;;;;;;
(ENTRY HAU SUBR 0)
(MOVEI 1 '(LABC (EVAL (1 L4)) (EVAL (2 L4))))
(JRST 0 EVAL)
(END)
; 12 DRO-------------------------------------------------------
(DE DRO () (LABC (EVAL (3 L4)) (EVAL (4 L4))))
FUNCTION LENGTH = 16
#LABEL = NIL
#LAP LENGTH = 2
;
;;;;;;
(ENTRY DRO SUBR 0)
(MOVEI 1 '(LABC (EVAL (3 L4)) (EVAL (4 L4))))
(JRST 0 EVAL)
(END)
; 13 BAS-------------------------------------------------------
(DE BAS () (LABC (EVAL (5 L4)) (EVAL (6 L4))))
FUNCTION LENGTH = 16
#LABEL = NIL
#LAP LENGTH = 2
;
;;;;;;
(ENTRY BAS SUBR 0)
(MOVEI 1 '(LABC (EVAL (5 L4)) (EVAL (6 L4))))
(JRST 0 EVAL)
(END)
; 14 GAU-------------------------------------------------------
(DE GAU () (LABC (EVAL (7 L4)) (EVAL (8 L4))))
FUNCTION LENGTH = 16
#LABEL = NIL
#LAP LENGTH = 2
;
;;;;;;
(ENTRY GAU SUBR 0)
(MOVEI 1 '(LABC (EVAL (7 L4)) (EVAL (8 L4))))
(JRST 0 EVAL)
(END)
; 15 AUTOUR-------------------------------------------------------
(DE AUTOUR () [(HAU) (DRO) (BAS) (GAU)])
FUNCTION LENGTH = 14
#LABEL = NIL
#LAP LENGTH = 23
;
;;;;;;
(ENTRY AUTOUR SUBR 0)
(PUSHJ P HAU)
(PUSH P 1)
(PUSHJ P DRO)
(PUSH P 1)
(PUSHJ P BAS)
(PUSH P 1)
(PUSHJ P GAU)
(HRLZ 1 1)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POPJ P)
(END)
; 16 TESTTOUR-------------------------------------------------------
(DE TESTTOUR ()
(IF (NEQ K 1)
(IF (AND (EQ HB 0) (EQ GD 0)) (SETQ K 1))
(CLOSE)))
FUNCTION LENGTH = 28
#LABEL = ((G128 POPJ P) (G130 . G128))
#LAP LENGTH = 12
;
;;;;;;
(ENTRY TESTTOUR SUBR 0)
(GETVAL 1 K)
(CAIN 1 '1)
(JRST 0 CLOSE)
(GETVAL 1 HB)
(CAIE 1 '0)
(JRST 0 :FALSE)
(GETVAL 1 GD)
(CAIE 1 '0)
(JRST 0 :FALSE)
(MOVEI 1 '1)
(PUTVAL 1 K)
(POPJ P)
(END)
; 17 SIL-Y-A-------------------------------------------------------
(DE SIL-Y-A (-X Y LL)
(IF (ATOM Y)
(EQ (OCCUR Y LL) -X)
(EQ -X
(APPLY 'PLUS (MAPCAR Y (LAMBDA (-X) (OCCUR -X LL)))))))
FUNCTION LENGTH = 38
#LABEL = NIL
#LABEL = ((G132 POPJ P))
#LAP LENGTH = 24
;
;;;;;;
(ENTRY %F3SIL-Y-A SUBR 1)
(JSP L :SBIND1)
(XWD '%F3SIL-Y-A '-X)
(GETVAL 2 LL)
(JRST 0 OCCUR)
;;;;;;
(ENTRY SIL-Y-A SUBR 3)
(JSP L :SBIND3)
(XWD 'SIL-Y-A '(-X Y LL))
(GETVAL 1 Y)
(CAML 1 :BLIST)
(JRST 0 G131)
(GETVAL 2 LL)
(PUSHJ P OCCUR)
(GETVAL 2 -X)
(JRST 0 EQ)
G131
(GETVAL 1 -X)
(PUSH P 1)
(GETVAL 1 Y)
(MOVEI 2 '%F3SIL-Y-A)
(PUSHJ P MAPCAR)
(MOVEI 2 0 1)
(MOVEI 1 'PLUS)
(PUSHJ P APPLY)
(POP P 2)
(JRST 0 EQ)
(END)
; 18 TER-------------------------------------------------------
(DE TER () (NEWL TER [I J]))
FUNCTION LENGTH = 11
#LABEL = NIL
#LAP LENGTH = 15
;
;;;;;;
(ENTRY TER SUBR 0)
(GETVAL 1 I)
(HLLZ 2 (:MEM 'J))
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(GETVAL 2 TER)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(PUTVAL 1 TER)
(POPJ P)
(END)
; 19 PP-------------------------------------------------------
(DE PP (A -X Y)
(IF (MEMQ (SETQ Y (A -X)) '(31 95 25 94))
(ASCII Y)
(IF (EQ Y 0) '/ Y)))
FUNCTION LENGTH = 37
#LABEL = ((G134 POPJ P) (G137 . G134) (G136 . G137))
#LAP LENGTH = 15
;
;;;;;;
(ENTRY PP SUBR 3)
(JSP L :SBIND3)
(XWD 'PP '(A -X Y))
(MOVEI 1 '(A -X))
(PUSHJ P EVAL)
(PUTVAL 1 Y)
(CAIE 1 '31)
(CAIN 1 '95)
(JRST 0 ASCII)
(CAIE 1 '25)
(CAIN 1 '94)
(JRST 0 ASCII)
G133
(CAIE 1 '0)
(POPJ P)
(MOVEI 1 '/ )
(POPJ P)
(END)
; 20 OCCUR-------------------------------------------------------
(DE OCCUR (-X LL)
(COND
((NULL LL) 0)
((EQ (NEXTL LL) -X) (ADD1 (SELF -X LL)))
(T (SELF -X LL))))
FUNCTION LENGTH = 32
#LABEL = ((G138 POPJ P))
#LAP LENGTH = 20
;
;;;;;;
(ENTRY OCCUR SUBR 2)
(JSP L :SBIND2)
(XWD 'OCCUR '(-X LL))
(GETVAL 1 LL)
(JUMPE 1 :CRAZER)
G139
(MOVEI 2 0 1)
(CAR 1 2)
(CDR 2 2)
(PUTVAL 2 LL)
(GETVAL 2 -X)
(PUSHJ P EQ)
(JUMPE 1 G140)
(GETVAL 1 -X)
(GETVAL 2 LL)
(PUSHJ P OCCUR)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JRST 0 :CRANUM)
G140
(GETVAL 1 -X)
(GETVAL 2 LL)
(JRST 0 OCCUR)
(END)
; 21 ED-------------------------------------------------------
(DE ED (LL) (APPEND (LAST LL) (PROGN (RPLACD (LAST LL 2)) LL)))
FUNCTION LENGTH = 19
#LABEL = NIL
#LAP LENGTH = 14
;
;;;;;;
(ENTRY ED SUBR 1)
(JSP L :SBIND1)
(XWD 'ED 'LL)
(SETZ 2)
(PUSHJ P LAST)
(PUSH P 1)
(GETVAL 1 LL)
(MOVEI 2 '2)
(PUSHJ P LAST)
(SETZ 2)
(RPLACD 1 2)
(GETVAL 1 LL)
(MOVEI 2 0 1)
(POP P 1)
(JRST 0 APPEND)
(END)
; 22 EG-------------------------------------------------------
(DE EG (LL) (RPLACD (LAST LL) [(CAR LL)]) (CDR LL))
FUNCTION LENGTH = 18
#LABEL = NIL
#LAP LENGTH = 12
;
;;;;;;
(ENTRY EG SUBR 1)
(JSP L :SBIND1)
(XWD 'EG 'LL)
(SETZ 2)
(PUSHJ P LAST)
(GETVAL 2 LL)
(HLLZ 2 :MEM 2)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(RPLACD 1 2)
(GETVAL 1 LL)
(CDR 1 1)
(POPJ P)
(END)
; 23 DECLARE-------------------------------------------------------
(DE DECLARE (NOM I J NOM1 NOM2)
(EVAL ['DA [QUOTE NOM] (TIMES I J) ''(LAMBDA (-X) 0)])
(EVAL
['DE NOM1 ['I 'J] [NOM ['+ ['* ['SUB1 'I] J] ['SUB1 'J]]]])
(EVAL ['DE NOM2 ['I 'J] ['+ ['* ['SUB1 'I] J] ['SUB1 'J]]]))
FUNCTION LENGTH = 122
#LABEL = NIL
#LAP LENGTH = 150
;
;;;;;;
(ENTRY DECLARE SUBR)
(JSP L :SBIND)
(XWD 'DECLARE '(NOM I J NOM1 NOM2))
(HLLZ 1 (:MEM 'NOM))
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'QUOTE)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(PUSH P 1)
(GETVAL 1 I)
(GETVAL 2 J)
(MOVE 5 :MEM 1)
(IMUL 5 :MEM 2)
(JSP L :$CRANB)
(HRLZI 2 ''(LAMBDA (-X) 0))
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'DA)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(PUSHJ P EVAL)
(GETVAL 1 NOM1)
(PUSH P 1)
(HRLZI 1 'J)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'I)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(PUSH P 1)
(GETVAL 1 NOM)
(PUSH P 1)
(HRLZI 1 'I)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'SUB1)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HLLZ 2 (:MEM 'J))
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(HRLI 1 '*)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLZI 2 'J)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRLI 2 'SUB1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRLZ 2 2)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(HRLI 1 '+)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLZ 1 1)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLZ 1 1)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'DE)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(PUSHJ P EVAL)
(GETVAL 1 NOM2)
(PUSH P 1)
(HRLZI 1 'J)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'I)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(PUSH P 1)
(HRLZI 1 'I)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'SUB1)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HLLZ 2 (:MEM 'J))
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(HRLI 1 '*)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLZI 2 'J)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRLI 2 'SUB1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRLZ 2 2)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(HRLI 1 '+)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLZ 1 1)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 'DE)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(JRST 0 EVAL)
(END)
; 24 COMBC-------------------------------------------------------
(DE COMBC (LL)
(IF LL
(IF (ZEROP (CAR LL)) 1 (ADD1 (SELF (CDR LL))))
(*EX "c'est impossible")))
FUNCTION LENGTH = 26
#LABEL = ((G143 POPJ P) (G145 . G143))
#LAP LENGTH = 14
;
;;;;;;
(ENTRY COMBC SUBR 1)
(JSP L :SBIND1)
(XWD 'COMBC 'LL)
(JUMPE 1 G142)
(CAR 1 1)
(CAIN 1 '0)
(JRST 0 :CRAONE)
G144
(GETVAL 1 LL)
(CDR 1 1)
(PUSHJ P COMBC)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JRST 0 :CRANUM)
G142
(MOVEI 1 '(*EX "c'est impossible"))
(JRST 0 EVAL)
(END)
; 25 MIN-------------------------------------------------------
(DE MIN (-X L)
(COND
((NULL L) NIL)
((SETQ XX (MEMBER -X L)) (MIN -X (CDR XX)))
((NULL (CDDR L)) [-X . L])
(T [-X . (MIN (CAR L) (CDR L))])))
FUNCTION LENGTH = 50
#LABEL = ((G146 POPJ P))
#LAP LENGTH = 34
;
;;;;;;
(ENTRY MIN SUBR 2)
(JSP L :SBIND2)
(XWD 'MIN '(-X L))
(GETVAL 1 L)
(JUMPE 1 :VPOPJ)
G147
(GETVAL 1 -X)
(GETVAL 2 L)
(PUSHJ P MEMBER)
(PUTVAL 1 XX)
(JUMPE 1 G148)
(GETVAL 1 -X)
(GETVAL 2 XX)
(CDR 2 2)
(JRST 0 MIN)
G148
(GETVAL 1 L)
(CDR 1 1)
(CDR 1 1)
(JUMPN 1 G149)
(GETVAL 1 L)
(HLL 1 (:MEM '-X))
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POPJ P)
G149
(GETVAL 1 -X)
(PUSH P 1)
(GETVAL 1 L)
(CAR 1 1)
(GETVAL 2 L)
(CDR 2 2)
(PUSHJ P MIN)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POPJ P)
(END)
; 26 MINI-------------------------------------------------------
(DE MINI (L) (MIN (CAR L) (CDR L)))
FUNCTION LENGTH = 13
#LABEL = NIL
#LAP LENGTH = 6
;
;;;;;;
(ENTRY MINI SUBR 1)
(JSP L :SBIND1)
(XWD 'MINI 'L)
(CAR 1 1)
(GETVAL 2 L)
(CDR 2 2)
(JRST 0 MIN)
(END)
; 27 INIT1-------------------------------------------------------
(DE INIT1 ()
(SETQ XPOS 5 YPOS 10)
(PPIOT 0 131074)
(PPIOT 2 409)
(PPIOT 3 (+ (* 15 512) 1))
(PPIOT 0 1)
(PPIOT 2 -305)
(PPIOT 3 (+ (* 3 512) 1))
(PPIOT 1 98304)
(STATUS 2 0 2))
FUNCTION LENGTH = 55
#LABEL = NIL
#LAP LENGTH = 39
;
;;;;;;
(ENTRY INIT1 SUBR 0)
(MOVEI 1 '5)
(PUTVAL 1 XPOS)
(MOVEI 1 '10)
(PUTVAL 1 YPOS)
(MOVEI 1 '0)
(MOVEI 2 '131074)
(PUSHJ P PPIOT)
(MOVEI 1 '2)
(MOVEI 2 '409)
(PUSHJ P PPIOT)
(MOVEI 1 '15)
(MOVEI 2 '512)
(PUSHJ P *)
(MOVEI 2 '1)
(PUSHJ P +)
(MOVEI 2 0 1)
(MOVEI 1 '3)
(PUSHJ P PPIOT)
(MOVEI 1 '0)
(MOVEI 2 '1)
(PUSHJ P PPIOT)
(MOVEI 1 '2)
(MOVEI 2 '-305)
(PUSHJ P PPIOT)
(MOVEI 1 '3)
(MOVEI 2 '512)
(PUSHJ P *)
(MOVEI 2 '1)
(PUSHJ P +)
(MOVEI 2 0 1)
(MOVEI 1 '3)
(PUSHJ P PPIOT)
(MOVEI 1 '1)
(MOVEI 2 '98304)
(PUSHJ P PPIOT)
(MOVEI 1 '2)
(MOVEI 2 '0)
(MOVEI 3 '2)
(JRST 0 :$3STATUS)
(END)
; 28 INIT-------------------------------------------------------
(DE INIT ()
(DISPL 'LAB)
(SETQ YPOS (PLUS 30 NJ) XPOS 5)
(DISPL 'L)
(SETQ XPOS 5 YPOS 10)
(PRINT "ou suis-je")
(ENTER)
(SETQ XPOS 5 YPOS 10)
(TTYS (+ XPOS I) (- (+ YPOS (* 2 J)) 3) "o")
(PRINT "pour commencer taper un caractere"))
FUNCTION LENGTH = 60
#LABEL = NIL
#LAP LENGTH = 44
;
;;;;;;
(ENTRY INIT SUBR 0)
(MOVEI 1 'LAB)
(SETZB 3 2)
(PUSHJ P DISPL)
(GETVAL 1 NJ)
(MOVEI 5 30)
(ADD 5 :MEM 1)
(JSP L :$CRANB)
(PUTVAL 1 YPOS)
(MOVEI 1 '5)
(PUTVAL 1 XPOS)
(MOVEI 1 'L)
(SETZB 3 2)
(PUSHJ P DISPL)
(MOVEI 1 '5)
(PUTVAL 1 XPOS)
(MOVEI 1 '10)
(PUTVAL 1 YPOS)
(MOVEI 1 '"ou suis-je")
(PUSHJ P :$PRINT)
(SETZ 1)
(PUSHJ P ENTER)
(MOVEI 1 '5)
(PUTVAL 1 XPOS)
(MOVEI 1 '10)
(PUTVAL 1 YPOS)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(GETVAL 1 XPOS)
(GETVAL 2 I)
(PUSHJ P +)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(MOVEI 1 '2)
(GETVAL 2 J)
(PUSHJ P *)
(POP P 2)
(PUSHJ P +)
(MOVEI 2 '3)
(PUSHJ P -)
(PUSH P 1)
(MOVEI 1 '"o")
(JSP L :NSUBR)
(MOVEI 1 '"pour commencer taper un caractere")
(JRST 0 :$PRINT)
;---------- # T B L
#TBL LENGTH = 1 ;
%T1 (XWD -1 TTYS)
(END)
; 29 TTYS-------------------------------------------------------
(DE TTYS (-X Y S IND)
(UPGIOT NIL
(APPEND [127 12 (LOGXOR 96 Y) (LOGXOR 96 -X)]
(MAPCAR (MAKLIST S) 'CASCII))))
FUNCTION LENGTH = 33
#LABEL = NIL
#LAP LENGTH = 34
;
;;;;;;
(ENTRY TTYS SUBR)
(JSP L :SBIND)
(XWD 'TTYS '(-X Y S IND))
(GETVAL 1 Y)
(MOVEI 5 96)
(XOR 5 :MEM 1)
(JSP L :$CRANP)
(GETVAL 1 -X)
(MOVEI 5 96)
(XOR 5 :MEM 1)
(JSP L :$CRANB)
(HRLZ 1 1)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 '12)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 '127)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(PUSH P 1)
(GETVAL 1 S)
(PUSHJ P MAKLIST)
(MOVEI 2 'CASCII)
(PUSHJ P MAPCAR)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P APPEND)
(MOVEI 2 0 1)
(SETZ 1)
(JRST 0 UPGIOT)
(END)
; 30 IMPWITH-------------------------------------------------------
(DE IMPWITH (-X)
(SETQA L (LI I J) -X)
(TTYS 6 (DIFFER YPOS 5) (REVERSTR (STRING [I '| J])))
(TTYS (+ XPOS OLDI) (+ YPOS (- (* 2 OLDJ) 2)) " ")
(SETQ OLDI I OLDJ J)
(TTYS (+ XPOS I) (+ YPOS (- (* 2 J) 2)) (STRING (ASCII -X))))
FUNCTION LENGTH = 75
#LABEL = NIL
#LAP LENGTH = 68
;
;;;;;;
(ENTRY IMPWITH SUBR 1)
(JSP L :SBIND1)
(XWD 'IMPWITH '-X)
(MOVEI 1 '(LI I J))
(PUSHJ P EVAL)
(GETVAL 2 -X)
(ARRAY 5 L)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(PUSH P %T2) ; '6 ;
(GETVAL 1 YPOS)
(MOVE 5 :MEM 1)
(SUBI 5 5)
(JSP L :$CRANP)
(GETVAL 1 I)
(HLLZ 2 (:MEM 'J))
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRLI 2 '|)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(PUSHJ P STRING)
(PUSHJ P REVERSTR)
(JSP L :NSUBR)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(GETVAL 1 XPOS)
(GETVAL 2 OLDI)
(PUSHJ P +)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(MOVEI 1 '2)
(GETVAL 2 OLDJ)
(PUSHJ P *)
(MOVEI 2 '2)
(PUSHJ P -)
(POP P 2)
(PUSHJ P +)
(PUSH P 1)
(MOVEI 1 '" ")
(JSP L :NSUBR)
(GETVAL 1 I)
(PUTVAL 1 OLDI)
(GETVAL 1 J)
(PUTVAL 1 OLDJ)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(GETVAL 1 XPOS)
(GETVAL 2 I)
(PUSHJ P +)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(MOVEI 1 '2)
(GETVAL 2 J)
(PUSHJ P *)
(MOVEI 2 '2)
(PUSHJ P -)
(POP P 2)
(PUSHJ P +)
(PUSH P 1)
(GETVAL 1 -X)
(PUSHJ P ASCII)
(PUSHJ P STRING)
(JRST 0 :NSUBRP)
;---------- # T B L
#TBL LENGTH = 2 ;
%T1 (XWD -1 TTYS)
%T2 '6
(END)
; 31 DISPL-------------------------------------------------------
(DE DISPL (A Y Z)
(IF (NEQ A 'LAB)
NIL
(TTYS 5 (- YPOS 5) "_ _")
(TTYS 6 (- YPOS 6) "| | |")
(TTYS 7 (- YPOS 5) "- -"))
(SETQ Z 0)
(TTYS XPOS YPOS (REVERSTR (STRING (LONG NJ))))
(SETQ OLD '/ )
(MAPARRAY A
(LAMBDA (-X)
(SETQ Y [(SETQ NEW (PP A -X)) . Y])
(NEWL Y
(COND
((MEMQ NEW '(- / /_)) NEW)
((EQ NEW '|)
(COND
((EQ OLD '|) '/ )
((EQ OLD '/ ) '/ )
((MEMQ OLD '(- /_))
(IF (ZEROP (REM -X NJ)) '/ OLD))
(T '/ )))
(T '/ )))
(SETQ OLD NEW)
(COND
((ZEROP (REM (ADD1 -X) NJ))
(TTYS (INCR XPOS) YPOS
(REVERSTR
(STRING [(INCR Z) . ['/ . (RPLACA Y '/ )]])))
(SETQ Y NIL))))))
FUNCTION LENGTH = 202
#LABEL = ((G166 POPJ P) (G157 . G153) (G163 . G157) (G155 . G153))
#LABEL = NIL
#LAP LENGTH = 139
;
;;;;;;
(ENTRY %F4DISPL SUBR 1)
(JSP L :SBIND1)
(XWD '%F4DISPL '-X)
(GETVAL 1 A)
(GETVAL 2 -X)
(SETZ 3)
(PUSHJ P PP)
(PUTVAL 1 NEW)
(GETVAL 2 Y)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(PUTVAL 1 Y)
(GETVAL 1 NEW)
(CAIE 1 '-)
(CAIN 1 '/ )
(JRST 0 G153)
(CAIN 1 '/_)
(JRST 0 G153)
G154
(CAIE 1 '|)
(JRST 0 G156)
(GETVAL 1 OLD)
(CAIE 1 '|)
(JRST 0 G158)
(MOVEI 1 '/ )
(JRST 0 G153)
G158
(CAIE 1 '/ )
(JRST 0 G159)
(MOVEI 1 '/ )
(JRST 0 G153)
G159
(CAIE 1 '-)
(CAIN 1 '/_)
(JRST 0 G161)
(JRST 0 G160)
G161
(GETVAL 1 -X)
(GETVAL 2 NJ)
(PUSHJ P :$REM)
(CAIE 1 '0)
(JRST 0 G162)
(MOVEI 1 '/ )
(JRST 0 G153)
G162
(GETVAL 1 OLD)
(JRST 0 G153)
G160
(MOVEI 1 '/ )
(JRST 0 G153)
G156
(MOVEI 1 '/ )
G153
(GETVAL 2 Y)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(PUTVAL 1 Y)
(GETVAL 1 NEW)
(PUTVAL 1 OLD)
(GETVAL 1 -X)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(GETVAL 2 NJ)
(PUSHJ P :$REM)
(CAIE 1 '0)
(JRST 0 :FALSE)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(GETVAL 1 XPOS)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(GETVAL 1 Z)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 Z)
(GETVAL 2 Y)
(MOVEI 3 '/ )
(RPLACA 2 3)
(HRLI 2 '/ )
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(PUSHJ P STRING)
(PUSHJ P REVERSTR)
(JSP L :NSUBR)
(SETZ 1)
(PUTVAL 1 Y)
(POPJ P)
;;;;;;
(ENTRY DISPL SUBR 3)
(JSP L :SBIND3)
(XWD 'DISPL '(A Y Z))
(GETVAL 1 A)
(CAIE 1 'LAB)
(JRST 0 G152)
G151
(PUSH P %T1) ; (XWD -1 TTYS) ;
(PUSH P %T2) ; '5 ;
(GETVAL 1 YPOS)
(MOVEI 2 '5)
(PUSHJ P -)
(PUSH P 1)
(MOVEI 1 '"_ _")
(JSP L :NSUBR)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(PUSH P %T3) ; '6 ;
(GETVAL 1 YPOS)
(MOVEI 2 '6)
(PUSHJ P -)
(PUSH P 1)
(MOVEI 1 '"| | |")
(JSP L :NSUBR)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(PUSH P %T4) ; '7 ;
(GETVAL 1 YPOS)
(MOVEI 2 '5)
(PUSHJ P -)
(PUSH P 1)
(MOVEI 1 '"- -")
(JSP L :NSUBR)
G152
(MOVEI 1 '0)
(PUTVAL 1 Z)
(PUSH P %T1) ; (XWD -1 TTYS) ;
(GETVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(GETVAL 1 NJ)
(PUSHJ P LONG)
(PUSHJ P STRING)
(PUSHJ P REVERSTR)
(JSP L :NSUBR)
(MOVEI 1 '/ )
(PUTVAL 1 OLD)
(GETVAL 1 A)
(MOVEI 2 '%F4DISPL)
(JRST 0 MAPARRAY)
;---------- # T B L
#TBL LENGTH = 4 ;
%T1 (XWD -1 TTYS)
%T2 '5
%T3 '6
%T4 '7
(END)
; 32 STRING1-------------------------------------------------------
(DE STRING1 (-X Y)
(MAPC (MAPCAR -X 'STRING)
(LAMBDA (-X) (SETQ Y (CONCAT -X (STRING Y))))))
FUNCTION LENGTH = 27
#LABEL = NIL
#LABEL = NIL
#LAP LENGTH = 16
;
;;;;;;
(ENTRY %F5STRING1 SUBR 1)
(JSP L :SBIND1)
(XWD '%F5STRING1 '-X)
(PUSH P %T1) ; (XWD -1 CONCAT) ;
(PUSH P 1)
(GETVAL 1 Y)
(PUSHJ P STRING)
(JSP L :NSUBR)
(PUTVAL 1 Y)
(POPJ P)
;;;;;;
(ENTRY STRING1 SUBR 2)
(JSP L :SBIND2)
(XWD 'STRING1 '(-X Y))
(MOVEI 2 'STRING)
(PUSHJ P MAPCAR)
(MOVEI 2 '%F5STRING1)
(JRST 0 :$MAPC1)
;---------- # T B L
#TBL LENGTH = 1 ;
%T1 (XWD -1 CONCAT)
(END)
; 33 LONG-------------------------------------------------------
(DE LONG (-X) (IF (ZEROP -X) NIL ['/ -X . (LONG (SUB1 -X))]))
FUNCTION LENGTH = 22
#LABEL = ((G170 POPJ P))
#LAP LENGTH = 17
;
;;;;;;
(ENTRY LONG SUBR 1)
(JSP L :SBIND1)
(XWD 'LONG '-X)
(CAIN 1 '0)
(JRST 0 :FALSE)
G169
(PUSH P 1)
(MOVE 5 :MEM 1)
(SUBI 5 1)
(JSP L :$CRANB)
(PUSHJ P LONG)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 '/ )
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(POPJ P)
(END)
; 34 ENTER-------------------------------------------------------
(DE ENTER (%A)
(SETQ %A 0)
(SETQ OLDXPOS XPOS)
(TTYC (SETQ XPOS (+ XPOS 2)) (+ %A YPOS))
(E1))
FUNCTION LENGTH = 28
#LABEL = NIL
#LAP LENGTH = 19
;
;;;;;;
(ENTRY ENTER SUBR 1)
(JSP L :SBIND1)
(XWD 'ENTER '%A)
(MOVEI 1 '0)
(PUTVAL 1 %A)
(GETVAL 1 XPOS)
(PUTVAL 1 OLDXPOS)
(GETVAL 1 XPOS)
(MOVEI 2 '2)
(PUSHJ P +)
(PUTVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 %A)
(GETVAL 2 YPOS)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E1)
(END)
; 35 E1-------------------------------------------------------
(DE E1 (%B)
(COND
((EQ (SETQ %B (TYI)) 32)
(TTYC XPOS (+ YPOS (SETQ %A (+ %A 2))))
(E2))
((EQ %B 13) (SETQ %A 0) (TTYC XPOS YPOS) (E1))
((EQ %B 10) (TTYC (INCR XPOS) (+ YPOS %A)) (E1))
((E1))))
FUNCTION LENGTH = 65
#LABEL = ((G171 POPJ P))
#LAP LENGTH = 49
;
;;;;;;
(ENTRY E1 SUBR 1)
(JSP L :SBIND1)
(XWD 'E1 '%B)
(41 0 5)
(JSP L :$CRANB)
(PUTVAL 1 %B)
(CAIE 1 '32)
(JRST 0 G172)
(GETVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(GETVAL 1 %A)
(MOVEI 2 '2)
(PUSHJ P +)
(PUTVAL 1 %A)
(POP P 2)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E2)
G172
(CAIE 1 '13)
(JRST 0 G173)
(MOVEI 1 '0)
(PUTVAL 1 %A)
(GETVAL 1 XPOS)
(GETVAL 2 YPOS)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E1)
G173
(CAIE 1 '10)
(JRST 0 G174)
(GETVAL 1 XPOS)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(GETVAL 2 %A)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E1)
G174
(SETZ 1)
(JRST 0 E1)
(END)
; 36 E2-------------------------------------------------------
(DE E2 (%B)
(COND
((EQ (SETQ %B (TYI)) 32)
(TTYC XPOS (+ YPOS (SETQ %A (+ %A 2))))
(E2))
((EQ %B 127) (TTYC XPOS (+ YPOS (SETQ %A (- %A 2)))) (E2))
((EQ %B 10) (TTYC (INCR XPOS) (+ YPOS %A)) (E2))
((EQ %B 13) (TTYC XPOS (+ YPOS (SETQ %A 0))) (E2))
((EQ %B 94) (TTYC (DECR XPOS) (+ YPOS %A)) (E2))
(T (SETQ I (- XPOS OLDXPOS) J (ADD1 (QUO %A 2)))
(PRINT I J))))
FUNCTION LENGTH = 120
#LABEL = ((G176 POPJ P))
#LAP LENGTH = 98
;
;;;;;;
(ENTRY E2 SUBR 1)
(JSP L :SBIND1)
(XWD 'E2 '%B)
(41 0 5)
(JSP L :$CRANB)
(PUTVAL 1 %B)
(CAIE 1 '32)
(JRST 0 G177)
(GETVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(GETVAL 1 %A)
(MOVEI 2 '2)
(PUSHJ P +)
(PUTVAL 1 %A)
(POP P 2)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E2)
G177
(CAIE 1 '127)
(JRST 0 G178)
(GETVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(PUSH P 1)
(GETVAL 1 %A)
(MOVEI 2 '2)
(PUSHJ P -)
(PUTVAL 1 %A)
(POP P 2)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E2)
G178
(CAIE 1 '10)
(JRST 0 G179)
(GETVAL 1 XPOS)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(GETVAL 2 %A)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E2)
G179
(CAIE 1 '13)
(JRST 0 G180)
(GETVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(MOVEI 2 '0)
(PUTVAL 2 %A)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E2)
G180
(CAIE 1 '94)
(JRST 0 G181)
(GETVAL 1 XPOS)
(MOVE 5 :MEM 1)
(SUBI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 XPOS)
(PUSH P 1)
(GETVAL 1 YPOS)
(GETVAL 2 %A)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(PUSHJ P TTYC)
(SETZ 1)
(JRST 0 E2)
G181
(GETVAL 1 XPOS)
(GETVAL 2 OLDXPOS)
(PUSHJ P -)
(PUTVAL 1 I)
(GETVAL 1 %A)
(MOVE 5 :MEM 1)
(IDIVI 5 2)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 J)
(GETVAL 1 I)
(PUSHJ P :$PRIN1)
(GETVAL 1 J)
(JRST 0 :$PRINT)
(END)
; 37 TTYC-------------------------------------------------------
(DE TTYC (X Y)
(PPIOT 8 (+ (STATUS 42 1) (LOC (LOGOR (LOGSHIFT Y 18) X)))))
FUNCTION LENGTH = 24
#LABEL = NIL
#LAP LENGTH = 20
;
;;;;;;
(ENTRY TTYC SUBR 2)
(JSP L :SBIND2)
(XWD 'TTYC '(X Y))
(MOVEI 1 '42)
(MOVEI 2 '1)
(PUSHJ P :$2STATUS)
(PUSH P 1)
(GETVAL 1 Y)
(MOVEI 2 '18)
(PUSHJ P LOGSHIFT)
(GETVAL 2 X)
(MOVE 5 :MEM 1)
(IOR 5 :MEM 2)
(JSP L :$CRANB)
(SETZ 2)
(PUSHJ P LOC)
(POP P 2)
(PUSHJ P +)
(MOVEI 2 0 1)
(MOVEI 1 '8)
(JRST 0 PPIOT)
(END)
; 38 CADRE-------------------------------------------------------
(DE CADRE (A)
(MAPARRAY A
(LAMBDA (X)
(COND
((LT X NJ) (SETA A X '-))
((GE X (* (SUB1 NI) NJ)) (SETA A X '-))
((OR (ZEROP (REM X NJ)) (EQ (REM X NJ) (SUB1 NJ)))
(SETA A X '|))
(T (SETA A X 0))))))
FUNCTION LENGTH = 75
#LABEL = ((G183 POPJ P))
#LABEL = NIL
#LAP LENGTH = 55
;
;;;;;;
(ENTRY %F6CADRE SUBR 1)
(JSP L :SBIND1)
(XWD '%F6CADRE 'X)
(GETVAL 2 NJ)
(MOVE 5 :MEM 1)
(CAML 5 :MEM 2)
(JRST 0 G184)
(GETVAL 1 A)
(GETVAL 2 X)
(MOVEI 3 '-)
(JRST 0 SETA)
G184
(GETVAL 1 X)
(PUSH P 1)
(GETVAL 1 NI)
(MOVE 5 :MEM 1)
(SUBI 5 1)
(JSP L :$CRANB)
(GETVAL 2 NJ)
(PUSHJ P *)
(POP P 2)
(MOVE 5 :MEM 1)
(CAML 5 :MEM 2)
(JRST 0 G185)
(GETVAL 1 A)
(GETVAL 2 X)
(MOVEI 3 '-)
(JRST 0 SETA)
G185
(GETVAL 1 X)
(GETVAL 2 NJ)
(PUSHJ P :$REM)
(CAIN 1 '0)
(JRST 0 G187)
(GETVAL 1 X)
(GETVAL 2 NJ)
(PUSHJ P :$REM)
(PUSH P 1)
(GETVAL 1 NJ)
(MOVE 5 :MEM 1)
(SUBI 5 1)
(JSP L :$CRANB)
(POP P 2)
(PUSHJ P EQ)
(JUMPE 1 G186)
G187
(GETVAL 1 A)
(GETVAL 2 X)
(MOVEI 3 '|)
(JRST 0 SETA)
G186
(GETVAL 1 A)
(GETVAL 2 X)
(MOVEI 3 '0)
(JRST 0 SETA)
;;;;;;
(ENTRY CADRE SUBR 1)
(JSP L :SBIND1)
(XWD 'CADRE 'A)
(MOVEI 2 '%F6CADRE)
(JRST 0 MAPARRAY)
(END)
; 39 EN1-------------------------------------------------------
(DE EN1 (I J %B)
(IF (GE I NI) (EX))
(TTYC1 I J)
(SETQ %B (TYI))
(COND
((EQ %B 32) (AVANCE) (TTYC1 I J) (EN1 I J))
((EQ %B 10) (SETQ I (ADD1 I)) (TTYC1 I J) (EN1 I J))
((EQ %B 13) (SETQ J 2) (TTYC1 I J) (EN1 I J))
((EQ %B 124)
(TYO1 %B)
(PUTA I J)
(AVANCE)
(TTYC1 I J)
(EN1 I J))
((EQ %B 45)
(PUTA I J)
(TYO1 %B)
(INCR J)
(TYO1 %B)
(INCR J)
(IF (GE J (* 2 NJ)) (SETQ J 2))
(TTYC1 I J)
(EN1 I J))
((EQ %B 94) (DECR I) (TTYC1 I J) (EN1 I J))
((EQ %B 95) (TTYC 21 3))
((EQ %B 127) (SETQ J (- J 2)) (TTYC1 I J) (EN1 I J))
((EQ %B 35)
(SETQ %B 32)
(PUTA I J)
(TYO1 32)
(INCR J)
(TYO1 32)
(INCR J)
(TTYC1 I J)
(EN1 I J))
(T (EN1 I J))))
FUNCTION LENGTH = 225
#LABEL = ((G191 POPJ P))
#LAP LENGTH = 162
;
;;;;;;
(ENTRY EN1 SUBR 3)
(JSP L :SBIND3)
(XWD 'EN1 '(I J %B))
(GETVAL 1 I)
(GETVAL 2 NI)
(MOVE 5 :MEM 1)
(CAMGE 5 :MEM 2)
(JRST 0 G189)
(MOVEI 1 '(EX))
(PUSHJ P EVAL)
G189
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(41 0 5)
(JSP L :$CRANB)
(PUTVAL 1 %B)
(CAIE 1 '32)
(JRST 0 G192)
(PUSHJ P AVANCE)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G192
(CAIE 1 '10)
(JRST 0 G193)
(GETVAL 1 I)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G193
(CAIE 1 '13)
(JRST 0 G194)
(MOVEI 1 '2)
(PUTVAL 1 J)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G194
(CAIE 1 '124)
(JRST 0 G195)
(PUSHJ P TYO1)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P PUTA)
(PUSHJ P AVANCE)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G195
(CAIE 1 '45)
(JRST 0 G196)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P PUTA)
(GETVAL 1 %B)
(PUSHJ P TYO1)
(GETVAL 1 J)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 J)
(GETVAL 1 %B)
(PUSHJ P TYO1)
(GETVAL 1 J)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 J)
(PUSH P 1)
(MOVEI 1 '2)
(GETVAL 2 NJ)
(PUSHJ P *)
(POP P 2)
(MOVE 5 :MEM 1)
(CAML 5 :MEM 2)
(JRST 0 G197)
(MOVEI 1 '2)
(PUTVAL 1 J)
G197
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G196
(CAIE 1 '94)
(JRST 0 G199)
(GETVAL 1 I)
(MOVE 5 :MEM 1)
(SUBI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G199
(CAIE 1 '95)
(JRST 0 G200)
(MOVEI 1 '21)
(MOVEI 2 '3)
(JRST 0 TTYC)
G200
(CAIE 1 '127)
(JRST 0 G201)
(GETVAL 1 J)
(MOVEI 2 '2)
(PUSHJ P -)
(PUTVAL 1 J)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G201
(CAIE 1 '35)
(JRST 0 G202)
(MOVEI 1 '32)
(PUTVAL 1 %B)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P PUTA)
(MOVEI 1 '32)
(PUSHJ P TYO1)
(GETVAL 1 J)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 J)
(MOVEI 1 '32)
(PUSHJ P TYO1)
(GETVAL 1 J)
(MOVE 5 :MEM 1)
(ADDI 5 1)
(JSP L :$CRANB)
(PUTVAL 1 J)
(GETVAL 1 I)
(GETVAL 2 J)
(PUSHJ P TTYC1)
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
G202
(GETVAL 1 I)
(GETVAL 2 J)
(SETZ 3)
(JRST 0 EN1)
(END)
; 40 TYO1-------------------------------------------------------
(DE TYO1 (%B)
(UPGIOT NIL
[127 12 (LOGXOR 96 (+ YPOS J)) (LOGXOR 96 (+ XPOS I)) %B]))
FUNCTION LENGTH = 27
#LABEL = NIL
#LAP LENGTH = 34
;
;;;;;;
(ENTRY TYO1 SUBR 1)
(JSP L :SBIND1)
(XWD 'TYO1 '%B)
(GETVAL 1 YPOS)
(GETVAL 2 J)
(PUSHJ P +)
(MOVEI 5 96)
(XOR 5 :MEM 1)
(JSP L :$CRANP)
(GETVAL 1 XPOS)
(GETVAL 2 I)
(PUSHJ P +)
(MOVEI 5 96)
(XOR 5 :MEM 1)
(JSP L :$CRANB)
(HLLZ 2 (:MEM '%B))
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(HRL 2 1)
(EXCH 2 :MEM FREE)
(EXCH FREE 2)
(MOVEI 1 0 2)
(POP P 2)
(HRL 1 2)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 '12)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(HRLI 1 '127)
(EXCH 1 :MEM FREE)
(EXCH FREE 1)
(MOVEI 2 0 1)
(SETZ 1)
(JRST 0 UPGIOT)
(END)
; 41 TTYC1-------------------------------------------------------
(DE TTYC1 (I J) (TTYC (+ XPOS I) (+ YPOS J)))
FUNCTION LENGTH = 16
#LABEL = NIL
#LAP LENGTH = 12
;
;;;;;;
(ENTRY TTYC1 SUBR 2)
(JSP L :SBIND2)
(XWD 'TTYC1 '(I J))
(GETVAL 1 XPOS)
(GETVAL 2 I)
(PUSHJ P +)
(PUSH P 1)
(GETVAL 1 YPOS)
(GETVAL 2 J)
(PUSHJ P +)
(MOVEI 2 0 1)
(POP P 1)
(JRST 0 TTYC)
(END)
; 42 AVANCE-------------------------------------------------------
(DE AVANCE () (IF (GE (SETQ J (+ J 2)) (* NJ 2)) (SETQ J 2)))
FUNCTION LENGTH = 23
#LABEL = ((G205 POPJ P))
#LAP LENGTH = 15
;
;;;;;;
(ENTRY AVANCE SUBR 0)
(GETVAL 1 J)
(MOVEI 2 '2)
(PUSHJ P +)
(PUTVAL 1 J)
(PUSH P 1)
(GETVAL 1 NJ)
(MOVEI 2 '2)
(PUSHJ P *)
(POP P 2)
(MOVE 5 :MEM 1)
(CAML 5 :MEM 2)
(JRST 0 :FALSE)
(MOVEI 1 '2)
(PUTVAL 1 J)
(POPJ P)
(END)
; 43 PUTA-------------------------------------------------------
(DE PUTA (I J) (SETQA LAB (LABI I (ADD1 (QUO J 2))) (ASCII %B)))
FUNCTION LENGTH = 21
#LABEL = NIL
#LAP LENGTH = 14
;
;;;;;;
(ENTRY PUTA SUBR 2)
(JSP L :SBIND2)
(XWD 'PUTA '(I J))
(MOVEI 1 '(LABI I (ADD1 (QUO J 2))))
(PUSHJ P EVAL)
(PUSH P 1)
(GETVAL 1 %B)
(PUSHJ P ASCII)
(MOVEI 2 0 1)
(POP P 1)
(ARRAY 5 LAB)
(ADD 5 :MEM 1)
(MOVEM 2 1 5)
(MOVEI 1 0 2)
(POPJ P)
(END)
;****************************** 3-Sep-78 23:00:03 COMPILEND ;